home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / OldSrc / CH1 / SRC / FONTLIST.FRM < prev    next >
Text File  |  1996-05-02  |  3KB  |  127 lines
  1. VERSION 4.00
  2. Begin VB.Form FontListForm 
  3.    Caption         =   "List Fonts"
  4.    ClientHeight    =   4515
  5.    ClientLeft      =   2115
  6.    ClientTop       =   1500
  7.    ClientWidth     =   4695
  8.    Height          =   5205
  9.    Left            =   2055
  10.    LinkTopic       =   "Form1"
  11.    ScaleHeight     =   4515
  12.    ScaleWidth      =   4695
  13.    Top             =   870
  14.    Width           =   4815
  15.    Begin VB.ListBox PrinterList 
  16.       Height          =   3930
  17.       Left            =   2400
  18.       MultiSelect     =   2  'Extended
  19.       Sorted          =   -1  'True
  20.       TabIndex        =   1
  21.       Top             =   480
  22.       Width           =   2175
  23.    End
  24.    Begin VB.ListBox ScreenList 
  25.       Height          =   3930
  26.       Left            =   120
  27.       MultiSelect     =   2  'Extended
  28.       Sorted          =   -1  'True
  29.       TabIndex        =   0
  30.       Top             =   480
  31.       Width           =   2175
  32.    End
  33.    Begin VB.Label Label1 
  34.       Alignment       =   2  'Center
  35.       Caption         =   "Printer Fonts"
  36.       Height          =   255
  37.       Index           =   1
  38.       Left            =   2400
  39.       TabIndex        =   3
  40.       Top             =   120
  41.       Width           =   2175
  42.    End
  43.    Begin VB.Label Label1 
  44.       Alignment       =   2  'Center
  45.       Caption         =   "Screen Fonts"
  46.       Height          =   255
  47.       Index           =   0
  48.       Left            =   120
  49.       TabIndex        =   2
  50.       Top             =   120
  51.       Width           =   2175
  52.    End
  53.    Begin VB.Menu mnuFile 
  54.       Caption         =   "&File"
  55.       Begin VB.Menu mnuFileExit 
  56.          Caption         =   "E&xit"
  57.       End
  58.    End
  59. End
  60. Attribute VB_Name = "FontListForm"
  61. Attribute VB_Creatable = False
  62. Attribute VB_Exposed = False
  63. Option Explicit
  64.  
  65. Private Sub Form_Load()
  66. Dim i1 As Integer
  67. Dim i2 As Integer
  68. Dim tst As Integer
  69.  
  70.     ' Fill the lists with font names.
  71.     For i1 = 0 To Printer.FontCount - 1
  72.         PrinterList.AddItem Printer.Fonts(i1)
  73.     Next i1
  74.  
  75.     For i2 = 0 To Screen.FontCount - 1
  76.         ScreenList.AddItem Screen.Fonts(i2)
  77.     Next i2
  78.  
  79.     ' Compare the items in the lists and
  80.     ' select any that are in one list but
  81.     ' missing in the other
  82.     i1 = 0
  83.     i2 = 0
  84.     Do While i1 < PrinterList.ListCount And _
  85.              i2 < ScreenList.ListCount
  86.         tst = StrComp(PrinterList.List(i1), ScreenList.List(i2))
  87.         If tst < 0 Then
  88.             ' Form font < Screen font
  89.             PrinterList.Selected(i1) = True
  90.             i1 = i1 + 1
  91.         ElseIf tst = 0 Then
  92.             ' They match
  93.             i1 = i1 + 1
  94.             i2 = i2 + 1
  95.         Else
  96.             ' Form font > Screen font
  97.             ScreenList.Selected(i2) = True
  98.             i2 = i2 + 1
  99.         End If
  100.     Loop
  101.  
  102.     Do While i1 < PrinterList.ListCount
  103.         PrinterList.Selected(i1) = True
  104.         i1 = i1 + 1
  105.     Loop
  106.  
  107.     Do While i2 < ScreenList.ListCount
  108.         ScreenList.Selected(i2) = True
  109.         i2 = i2 + 1
  110.     Loop
  111.  
  112.     PrinterList.TopIndex = 0
  113.     ScreenList.TopIndex = 0
  114. End Sub
  115.  
  116.  
  117. Private Sub Form_Unload(Cancel As Integer)
  118.     End
  119. End Sub
  120.  
  121.  
  122. Private Sub mnuFileExit_Click()
  123.     Unload Me
  124. End Sub
  125.  
  126.  
  127.